module PPUDefs where

import Data.Int
import Data.Word
import Data.Bits
import Data.STRef
import Data.Array.ST
import Control.Monad.ST
import Control.Monad.Reader

data PPU = PPU {
      control1      :: Operand
    , control2      :: Operand
    , status        :: Operand
    , oamAddr       :: Operand
    , oamData       :: Operand
    , ppuScroll     :: Operand
    , ppuAddr       :: Operand
    , ppuData       :: Operand
}

type Address = Word16
type Operand = Int8

type MemArray s = STUArray s Address Operand
data PPUMemory s = PPUMemory {
      tiles         :: MemArray s
    , nameTables    :: MemArray s
    , palettes      :: MemArray s
}

type Graphics s a = ReaderT (STRef s PPU, PPUMemory s) (ST s) a

getPPU :: Graphics s PPU
getPPU = asks fst >>= lift . readSTRef

-- Stuff related to $2000, control1
data SpriteSize = Eight | Sixteen

-- determine wheather we should generate NMI on VBlank or not
nmiOnVBlank :: Graphics s Bool
nmiOnVBlank = do
    ppu <- getPPU
    return $ control1 ppu .&. 0x80 /= 0

-- Sprite size is 8x8 or 8x16
getSpriteSize :: Graphics s SpriteSize
getSpriteSize = do
    ppu <- getPPU
    if control1 ppu .&. 0x20 == 0
        then return Eight
        else return Sixteen

bgTableAddress :: Graphics s Address
bgTableAddress = do
    ppu <- getPPU
    if control1 ppu .&. 0x10 == 0
        then return 0x0000
        else return 0x1000

spriteTableAddress :: Graphics s Address
spriteTableAddress = do
    ppu <- getPPU
    if control1 ppu .&. 0x08 == 0
        then return 0x0000
        else return 0x1000

getPPUAddrInc :: Graphics s Int
getPPUAddrInc = do
    ppu <- getPPU
    if control1 ppu .&. 0x04 == 0
        then return 1
        else return 32

getNameTableAddress :: Graphics s Address
getNameTableAddress = do
    ppu <- getPPU
    case control1 ppu .&. 0x03 of
        0x00 -> return 0x2000
        0x01 -> return 0x2400
        0x10 -> return 0x2800
        0x11 -> return 0x2C00

-- Stuff related to $2001, control2
data NESColor = Red | Green | Blue | None

-- Get the full background color (when control2.0 == 0)
getBGColor :: Graphics s NESColor
getBGColor = do
    ppu <- getPPU
    case control2 ppu .&. 0xE0 of
        0x0 -> return None
        0x1 -> return Green
        0x2 -> return Blue
        0x3 -> return Red

-- Get what color to intensify (when control2.0 == 1)
getIntensifyColor :: Graphics s NESColor
getIntensifyColor = getBGColor

isSpriteVisible :: Graphics s Bool
isSpriteVisible = do
    ppu <- getPPU
    return $ control2 ppu .&. 0x10 /= 0

isBGVisible :: Graphics s Bool
isBGVisible = do
    ppu <- getPPU
    return $ control2 ppu .&. 0x08 /= 0

hasSpriteClipping :: Graphics s Bool
hasSpriteClipping = do
    ppu <- getPPU
    return $ control2 ppu .&. 0x04 == 0

hasBGClipping :: Graphics s Bool
hasBGClipping = do
    ppu <- getPPU
    return $ control2 ppu .&. 0x02 == 0

data DispType = Color | Monochrome
getDisplayType :: Graphics s DispType
getDisplayType = do
    ppu <- getPPU
    if control2 ppu .&. 0x01 == 0
        then return Color
        else return Monochrome

-- Stuff related to $2002
hasSpriteOverflow :: Graphics s Bool
hasSpriteOverflow = do
    ppu <- getPPU
    return $ status ppu .&. 0x20 /= 0

hasSpriteHit :: Graphics s Bool
hasSpriteHit = do
    ppu <- getPPU
    return $ status ppu `testBit` 6

hasVBlank :: Graphics s Bool
hasVBlank = do
    ppu <- getPPU
    return $ status ppu `testBit` 7


